home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
SHELLS
/
SZ2
/
GEDITOR.IMP
< prev
next >
Wrap
Text File
|
1992-08-31
|
18KB
|
494 lines
{*******************************************************************
GEDITOR.IMP
*******************************************************************}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
EDITOR-SPECIFIC
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
EXTENT - return "cascaded" extent of current or first TWindow
===================================================================}
procedure FirstExtent ( VAR R : TRect ) ;
begin
DeskTop^.GetExtent ( R ) ;
if Desktop^.Current = NIL then EXIT ;
if not Desktop^.Current^.GetState ( sfVisible ) then EXIT ;
Desktop^.Current^.GetBounds ( R ) ;
if R.B.X - R.A.X > MinWinSize.X then
inc ( R.A.X ) ;
if R.B.Y - R.A.Y > MinWinSize.Y then
inc ( R.A.Y ) ;
end ;
{===================================================================
EXTENT - return "cascaded" extent of current or first TEditWindow
===================================================================}
procedure FirstExtentEd ( VAR R : TRect ) ;
{-------------------------------------------------------------------
CURRENT
-------------------------------------------------------------------}
function Test ( P : PView ) : boolean ; FAR ;
begin
Test := FALSE ;
if TypeOf ( P^ ) <> TypeOf ( TEditWindow ) then EXIT ;
with PEDITWINDOW ( P )^.Editor^ do
begin
if not P^.GetState ( sfVisible ) then EXIT ;
P^.GetBounds ( R ) ;
Test := TRUE ;
if R.B.X - R.A.X > MinWinSize.X then
inc ( R.A.X ) ;
if R.B.Y - R.A.Y > MinWinSize.Y then
inc ( R.A.Y ) ;
end ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
DeskTop^.GetExtent ( R ) ;
Desktop^.FirstThat ( @Test ) ;
end ;
{===================================================================
NUMBER
===================================================================}
function WinNumExist ( WinNum : integer ) : boolean ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
function Test ( P : PView ) : boolean ; FAR ;
begin
Test := FALSE ;
if not Selectable ( P ) then EXIT ;
Test := WinNum = PWINDOW ( P )^.Number ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
WinNumExist := Desktop^.FirstThat ( @Test ) <> NIL ;
end ;
{===================================================================
NUMBER
===================================================================}
function NextWinNum : integer ;
var
i : integer ;
begin
for i := 1 to 9 do
if not WinNumExist ( i ) then
begin
NextWinNum := i ;
EXIT ;
end ;
NextWinNum := wnNoNumber ;
end ;
{===================================================================
Opens a window, with choice of whether visible.
Sets "AutoIndent" on. If NewEdit, set wrap & right margin.
===================================================================}
function OpenEditor ( FileName : FNameStr ;
Visible : boolean ) : PEditWindow ;
var
P : PView ;
R : TRect ;
begin
OpenEditor := NIL ;
if Visible then
FirstExtentEd ( R )
else
DeskTop^.GetExtent ( R ) ;
P := Application^.ValidView (
New ( PEditWindow ,
Init ( R , FileName, NextWinNum ) ) ) ;
if P = NIL then EXIT ;
with PEDITWINDOW ( P )^ do
begin
if not Visible then
Hide ;
Editor^.AutoIndent := TRUE ;
{$IFDEF newedit }
Editor^.Word_Wrap := Default_Word_Wrap ;
Editor^.Right_Margin := Default_Line_Length ;
{$ENDIF }
end ;
DeskTop^.Insert ( P ) ;
OpenEditor := PEDITWINDOW ( P ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
SAVE/CLOSE
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
IF CHANGED
===================================================================}
procedure SaveEdModified ;
var
Count : byte ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TEditWindow ) then EXIT ;
with PEDITWINDOW ( P )^.Editor^ do
begin
if not Modified then EXIT ;
SetBorder ( 14 ) ; { YELLOW - busy }
Save ;
inc ( Count ) ;
end ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
Count := 0 ;
Desktop^.ForEach ( @DoThis ) ;
if Count > 0 then
SetBorder ( 0 ) ; { BLACK - done }
end ;
{===================================================================
ALWAYS A DIALOG FOR NAME
===================================================================}
procedure SaveEdUntitled ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TEditWindow ) then EXIT ;
with PEDITWINDOW ( P )^.Editor^ do
begin
if not Modified then EXIT ;
if FileName <> '' then EXIT ;
P^.MakeFirst ; { bring to front }
SaveAs ;
end ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
Desktop^.ForEach ( @DoThis ) ;
end ;
{===================================================================
CLOSE - "Untitled" TEditWindow(s). Must force "Modified" flag,
since cmClose won't work if ^. Valid returns FALSE.
===================================================================}
procedure CloseEdUntitled ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TEditWindow ) then EXIT ;
with PEDITWINDOW ( P )^.Editor^ do
begin
if FileName <> '' then EXIT ;
Modified := FALSE ;
end ;
Message ( P , evCommand , cmClose , NIL ) ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
Desktop^.ForEach ( @DoThis ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
CLIP BOARD
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
CREATE
===================================================================}
procedure CreateClipboard ;
var
R : TRect ;
begin
if not BuffersInUse then EXIT ;
ClipWindow := OpenEditor ( '' , FALSE ) ;
if ClipWindow = NIL then EXIT ;
Clipboard := ClipWindow^.Editor ;
Clipboard^.CanUndo := FALSE ;
ClipWindow^.HelpCtx := SaveClipCtx ;
ClipWindow^.Number := wnNoNumber ;
Desktop^.GetExtent ( R ) ;
R.Grow ( -10 , -5 ) ;
ClipWindow^.Locate ( R ) ;
end ;
{===================================================================
DISPOSE
===================================================================}
procedure DisposeClipboard ;
begin
if ClipWindow = NIL then EXIT ;
SaveClipCtx := ClipWindow^.HelpCtx ;
Dispose ( Clipboard , Done ) ;
Clipboard := NIL ;
Dispose ( ClipWindow , Done ) ;
ClipWindow := NIL ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
BUFFERS - to start & end heap management
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
PARAGRAPHS - Available heap space, in "Paragraphs"
===================================================================}
function HeapParagraphs : word ;
begin
HeapParagraphs := PtrRec ( HeapEnd ).Seg -
PtrRec ( HeapPtr ).Seg ;
end ;
{===================================================================
BUFFER - Reserve "Paragraphs" for data, remaining for editor/buffers
===================================================================}
procedure ReserveForData ( Paragraphs : word ) ;
begin
if BufHeapSize <> 0 then EXIT ;
if HeapParagraphs > Paragraphs then
BufHeapSize := HeapParagraphs - Paragraphs
else
BufHeapSize := 0 ;
end ;
{===================================================================
HEAP - Reserve "Paragraphs" for editor/buffers, remaining for data
===================================================================}
procedure ReserveForEditor ( Paragraphs : word ) ;
begin
if BufHeapSize <> 0 then EXIT ;
if HeapParagraphs > Paragraphs then
BufHeapSize := Paragraphs
else
BufHeapSize := 0 ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
EDITOR
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
TYPE
===================================================================}
function IsEDIT ( P : PView ) : boolean ;
begin
IsEDIT := ( P <> NIL ) and
( TypeOf ( P^ ) = TypeOf ( TEditWindow ) ) ;
end ;
{===================================================================
EMPTY
===================================================================}
function IsEditEmpty ( P : PView ) : boolean ;
begin
IsEditEmpty := IsEdit ( P ) and
( PEDITWINDOW ( P )^.Editor^.BufLen = 0 ) ;
end ;
{===================================================================
SELECTED
===================================================================}
function IsTextSelected ( P : PView ) : boolean ;
begin
IsTextSelected := IsEdit ( P ) and
( PEDITWINDOW ( P )^.Editor^.SelStart <>
PEDITWINDOW ( P )^.Editor^.SelEnd ) and
(
( PEDITWINDOW ( P )^.Editor^.CurPtr =
PEDITWINDOW ( P )^.Editor^.SelEnd ) or
( PEDITWINDOW ( P )^.Editor^.CurPtr =
PEDITWINDOW ( P )^.Editor^.SelStart )
) ;
end ;
{===================================================================
NAME - Return filename, since "title" may not contain path/dir.
===================================================================}
function GetNameEdit ( P : PView ) : string ;
begin
if IsEDIT ( P ) then
GetNameEdit := PEDITWINDOW ( P )^.Editor^.FileName
else
GetNameEdit := '' ;
end ;
{===================================================================
UNTITLED - if name blank & title = Untitled.
===================================================================}
function IsUntitled ( P : PView ) : boolean ;
begin
IsUntitled := IsEdit ( P ) and
( GetNameEdit ( P ) = '' ) and
( Match ( 'untitled' ,
PWINDOW ( P )^.GetTitle ( 255 ) ) = 1 ) ;
end ;
{===================================================================
CLIPBOARD - if name blank & title = Clipboard.
===================================================================}
function IsClipboard ( P : PView ) : boolean ;
begin
IsClipboard := IsEdit ( P ) and
not IsUntitled ( P ) and
( GetNameEdit ( P ) = '' ) ;
end ;
{===================================================================
FILENAME - return pointer to first TEditWindow
===================================================================}
function FirstEd : pointer ;
{-------------------------------------------------------------------
Test view
-------------------------------------------------------------------}
function Test ( P : PView ) : boolean ; FAR ;
begin
Test := IsEDIT ( P ) ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
FirstEd := Desktop^.FirstThat ( @Test ) ;
end ;
{===================================================================
EDITOR
===================================================================}
function ExistEditor : boolean ;
{-------------------------------------------------------------------
Any TEditWindows? "Visible" test ignores Clipboard if not on-screen
-------------------------------------------------------------------}
function Test ( P : PView ) : boolean ; FAR ;
begin
Test := IsEdit ( P ) and
Visible ( P ) ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
ExistEditor := Desktop^.FirstThat ( @Test ) <> NIL ;
end ;
{===================================================================
EXIST - return pointer to file if in Desktop
===================================================================}
function ExistEdName ( S : string ) : pointer ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
function Test ( P : PView ) : boolean ; FAR ;
begin
Test := FALSE ;
if not IsEDIT ( P ) then EXIT ;
with PEDITWINDOW ( P )^ do
Test := Editor^.FileName = S ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
S := StrUpCase ( S ) ;
ExistEdName := Desktop^.FirstThat ( @Test ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
CURRENT
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
ED
===================================================================}
function EdIsCurrent : boolean ;
begin
EdIsCurrent := IsEDIT ( Desktop^.Current ) ;
end ;
{===================================================================
NAME - EditWindow
===================================================================}
function NameCurrent : string ;
begin
NameCurrent := GetNameEdit ( Desktop^.Current )
end ;
{===================================================================
UNTITLED
===================================================================}
function UntitledIsCurrent : boolean ;
begin
UntitledIsCurrent := IsUntitled ( Desktop^.Current ) ;
end ;
{===================================================================
CLIP
===================================================================}
function ClipIsCurrent : boolean ;
begin
ClipIsCurrent := IsClipboard ( Desktop^.Current ) ;
end ;
{===================================================================
DIALOG
===================================================================}
function DialogIsCurrent : boolean ;
begin
DialogIsCurrent := TypeOf ( Desktop^.Current^ ) =
TypeOf ( TDialog ) ;
end ;
{===================================================================
HELP
===================================================================}
function HelpIsCurrent : boolean ;
begin
HelpIsCurrent := ( TypeOf ( Desktop^.Current^ ) =
TypeOf ( THelpWindow ) )
or
( TypeOf ( Application^.Current^ ) =
TypeOf ( THelpWindow ) ) ;
end ;